home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / Cookies.tcl < prev    next >
Encoding:
Text File  |  2004-02-21  |  7.3 KB  |  214 lines
  1. ##############################################################################
  2. ##############################################################################
  3. #                               Cookies.tcl
  4. ##############################################################################
  5. ##############################################################################
  6. # In this file are implemented the procedures to deal with the cookies.
  7. ##############################################################################
  8. ##############################################################################
  9. # Copyright 2001 AndrΘs Garcφa Garcφa  -- fandom@retemail.es
  10. # Distributed under the terms of the GPL v2
  11. ##############################################################################
  12. ##############################################################################
  13.  
  14. namespace eval Cookies  {
  15.  
  16. ##############################################################################
  17. # SaveCookie
  18. #    Gets the cookie header and saves it in the 'cookies.txt' file.
  19. #
  20. # Parameter
  21. #    header: the header we got from the server
  22. ##############################################################################
  23. proc SaveCookie {header} {
  24.     global dirGetleft
  25.  
  26.     set parsedUrl [HtmlParser::ParseUrl $Ventana::link]
  27.     set domain [lindex $parsedUrl 1]
  28.     set dir    [lindex $parsedUrl 2]
  29.     if {$dir==""} {
  30.         set dir /
  31.     }
  32.  
  33.     if {![regexp {(?::\s)(.+?)(?:;)}   $header nada cookies]} return
  34.     if {![regexp -nocase {(?:path=)(.+?)(?:\.*$|;| )} $header nada path]} {
  35.         set path $dir
  36.     }
  37.     if {![regexp -nocase {(?:domain=)(.+?)(?:\.*$|;| )} $header nada domain]} {
  38.         set domain $domain
  39.     }
  40.     if {[regexp {^\.} $domain]} {
  41.         set share TRUE
  42.     } else {
  43.         set share FALSE
  44.     }
  45.     if {[regexp -nocase {(?:expires=)(.+?)(?:\.*$|;)} $header nada date]} {
  46.         # clock scan doesn't like dates after 2037
  47.         if {[catch {set expires [clock scan $date]}]} {
  48.            set expires [clock scan "Thur, 31 Dec 2037 07:43:04 GMT"]
  49.         }
  50.     } else {
  51.         set expires [expr {[clock seconds]} + 3600]
  52.     }
  53.     if {[regexp -nocase {secure} $header]} {
  54.         set secure TRUE
  55.     } else {
  56.         set secure FALSE
  57.     }
  58.     if {[regexp {([^=]+)(?:=)(.*)} $cookies nada cookieName cookieValue]} {
  59.         StoreCookie $domain $share $path $secure $expires                    \
  60.                 $cookieName $cookieValue
  61.     }
  62.     WriteCookies
  63.  
  64.     return
  65. }
  66.  
  67. ##############################################################################
  68. # CheckCookies
  69. #    Reads the file 'cookies.txt' and checks whether the cookies are current,
  70. #    deletes those which are not and saves the resulting file.
  71. ##############################################################################
  72. proc CheckCookies {} {
  73.     variable cookies
  74.     global   dirGetleft
  75.  
  76.     set now [clock seconds]
  77.  
  78.     if {[ReadCookies]==1} return
  79.  
  80.     set cookieJar  [file join $dirGetleft(conf) cookies.txt]
  81.     set cookieTemp [file join $dirGetleft(conf) cookies.tmp]
  82.  
  83.     if {[catch {open "$cookieTemp" w+} tempHandle]} return
  84.  
  85.     for {set i 0} {[info exists cookies($i,domain)]} {incr i} {
  86.         if {"$cookies($i,expires).0">$now} {
  87.             puts -nonewline $tempHandle "$cookies($i,domain)\t"
  88.             puts -nonewline $tempHandle "$cookies($i,share)\t"
  89.             puts -nonewline $tempHandle "$cookies($i,path)\t"
  90.             puts -nonewline $tempHandle "$cookies($i,secure)\t"
  91.             puts -nonewline $tempHandle "$cookies($i,expires)\t"
  92.             puts -nonewline $tempHandle "$cookies($i,cookie)\t"
  93.             puts            $tempHandle "$cookies($i,value)"
  94.         }
  95.     }
  96.     close $tempHandle
  97.  
  98.     if {[catch {file rename -force -- $cookieTemp $cookieJar}]} {
  99.         catch {file delete $cookieTemp}
  100.     }
  101.  
  102.     return
  103. }
  104.  
  105. ##############################################################################
  106. # ReadCookies
  107. #    Read the cookie.txt file into memory
  108. #
  109. # Returns:
  110. #    '0' if all went well, '1' otherwise.
  111. ##############################################################################
  112. proc ReadCookies {} {
  113.     global dirGetleft
  114.     variable cookies
  115.  
  116.     set cookieJar  [file join $dirGetleft(conf) cookies.txt]
  117.     if {[catch {open "$cookieJar" r} cookieHandle]} {
  118.         return 1
  119.     }
  120.     catch "unset Cookies::cookies"
  121.     for {set i 0} {![eof $cookieHandle]} {} {
  122.         set line [gets $cookieHandle]
  123.  
  124.         if {[regexp {^#|^\s|^$} $line]} continue
  125.  
  126.         set cookies($i,domain)  [lindex $line 0]
  127.         set cookies($i,share)   [lindex $line 1]
  128.         set cookies($i,path)    [lindex $line 2]
  129.         set cookies($i,secure)  [lindex $line 3]
  130.         set cookies($i,expires) [lindex $line 4]
  131.         set cookies($i,cookie)  [lindex $line 5]
  132.         set cookies($i,value)   [lindex $line 6]
  133.         incr i
  134.     }
  135.     close $cookieHandle
  136.     return 0
  137. }
  138.  
  139. ##############################################################################
  140. # WriteCookies
  141. #    Writes the cookies into the cookie file.
  142. ##############################################################################
  143. proc WriteCookies {} {
  144.     global dirGetleft
  145.     variable cookies
  146.  
  147.     if {![info exists cookies(0,domain)]} return
  148.  
  149.     set cookieJar [file join $dirGetleft(conf) cookies.txt]
  150.     set cookieHandle [open "$cookieJar" w]
  151.  
  152.     for {set i 0} {[info exists cookies($i,domain)]} {incr i} {
  153.         puts -nonewline $cookieHandle "$cookies($i,domain)\t"
  154.         puts -nonewline $cookieHandle "$cookies($i,share)\t"
  155.         puts -nonewline $cookieHandle "$cookies($i,path)\t"
  156.         puts -nonewline $cookieHandle "$cookies($i,secure)\t"
  157.         puts -nonewline $cookieHandle "$cookies($i,expires)\t"
  158.         puts -nonewline $cookieHandle "$cookies($i,cookie)\t"
  159.         puts            $cookieHandle "$cookies($i,value)"
  160.     }
  161.     close $cookieHandle
  162.  
  163.     return
  164. }
  165.  
  166. ##############################################################################
  167. # SeeCookies
  168. #    Writes in the console the cookies we have in memory.
  169. ##############################################################################
  170. proc SeeCookies {} {
  171.     global dirGetleft
  172.     variable cookies
  173.  
  174.     for {set i 0} {[info exists cookies($i,domain)]} {incr i} {
  175.         puts -nonewline "$cookies($i,domain)\t$cookies($i,share)\t$cookies($i,path)\t"
  176.         puts -nonewline "$cookies($i,secure)\t$cookies($i,expires)\t"
  177.         puts            "$cookies($i,cookie)\t$cookies($i,value)"
  178.     }
  179.     return
  180. }
  181.  
  182. ##############################################################################
  183. # StoreCookie
  184. #    Either stores the new cookie or changes it if we already have it.
  185. #
  186. # Parameters:
  187. #    I hope they are selfexplanatory.
  188. ##############################################################################
  189. proc StoreCookie {domain share path secure expires cookie value} {
  190.     variable cookies
  191.  
  192.     for {set i 0} {[info exists cookies($i,domain)]} {incr i} {
  193.         if {($cookies($i,domain)==$domain)&&($cookies($i,path)==$path)&&
  194.             ($cookies($i,secure)==$secure)&&($cookies($i,cookie)==$cookie)} {
  195.             break
  196.         }
  197.     }
  198.     set cookies($i,domain)  $domain
  199.     set cookies($i,share)   $share
  200.     set cookies($i,path)    $path
  201.     set cookies($i,secure)  $secure
  202.     set cookies($i,expires) $expires
  203.     set cookies($i,cookie)  $cookie
  204.     set cookies($i,value)   $value
  205.  
  206.     return
  207. }
  208.  
  209. # when we read the namespace for the first time we check the cookies
  210.  
  211. CheckCookies
  212.  
  213. }
  214.